home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / pcmagazi / 1989 / 18 / scrndump.pas < prev    next >
Pascal/Delphi Source File  |  1989-09-18  |  2KB  |  87 lines
  1. scrndump.pas
  2.  
  3.  
  4.  
  5. UNIT ScrnDump;
  6. {   Written by: Thomas L. Bregante, 1988 }
  7.  
  8. INTERFACE
  9.  
  10. USES
  11.   Graph,
  12.   Printer;
  13.  
  14. CONST
  15.   EpsonFx = 1;
  16.   IBMGR = 2;
  17.   IBMPRO = 2;
  18.  
  19.   PROCEDURE Scrdmp(PrinterType : Byte);
  20.  
  21. IMPLEMENTATION
  22.  
  23.   PROCEDURE Scrdmp(PrinterType : Byte);
  24.   CONST
  25.     Esc = $1B;
  26.   VAR
  27.     K, I, X, Y : Integer;
  28.     Pins, Pin, Bcolor : Byte;
  29.     Vlimit, Hlimit, Vextra, Klimit : Integer;
  30.  
  31.     PROCEDURE InitLine(Columns : Integer);
  32.       { Setup for double density graphics}
  33.     VAR
  34.       ColMod, ColDiv : Byte;
  35.     BEGIN
  36.       ColDiv := Columns DIV 256;
  37.       ColMod := Columns MOD 256;
  38.       Write(lst, Char(Esc), 'L', Char(ColMod), Char(ColDiv));
  39.     END;
  40.  
  41.     PROCEDURE SetPrinter(Ptype : Byte);
  42.       { Set to 8/72 inches per line}
  43.     BEGIN
  44.       CASE Ptype OF
  45.         1 : WriteLn(lst, Char(Esc), 'A', Char(8));
  46.         2 : WriteLn(lst, Char(Esc), 'A', Char(8), Char(Esc), '2');
  47.       END;                        (* Case *)
  48.     END;
  49.  
  50.     PROCEDURE ResetPrinter(Ptype : Byte);
  51.       { Set to 6 lines per inch and sent a form feed. }
  52.     BEGIN
  53.       CASE Ptype OF
  54.         1, 2 : WriteLn(lst, Char(Esc), '2', Char(12));
  55.       END;                        (* Case *)
  56.     END;
  57.  
  58.   BEGIN
  59.     SetPrinter(PrinterType);
  60.     Bcolor := GetBkColor;
  61.     Hlimit := GetMaxX;
  62.     Vlimit := GetMaxY DIV 8;
  63.     Vextra := GetMaxY MOD 8;
  64.     Klimit := 7;
  65.     FOR I := 0 TO Vlimit DO
  66.       BEGIN
  67.         InitLine(Hlimit+1);
  68.         FOR X := 0 TO Hlimit DO
  69.           BEGIN
  70.             Pins := 0;
  71.             IF I = Vlimit THEN Klimit := Vextra;
  72.             FOR K := 0 TO Klimit DO
  73.               BEGIN
  74.                 Y := (I*8)+K;
  75.                 Pin := GetPixel(X, Y);
  76.                 IF Pin <> Bcolor THEN {Compare to background}
  77.                   Pins := Pins+1 SHL (7-K); {Calc power of 2}
  78.               END;
  79.             Write(lst, Char(Pins));
  80.           END;
  81.         WriteLn(lst);
  82.       END;
  83.     ResetPrinter(PrinterType);
  84.   END;                            {SCRDMP}
  85.  
  86. END.
  87.